home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Information / CSMP Digest / volume 2 / csmp-v2-016.txt < prev    next >
Text File  |  1995-06-30  |  50KB  |  1,529 lines
  1. C.S.M.P. Digest             Wed, 24 Feb 93       Volume 2 : Issue 16
  2.  
  3. Today's Topics:
  4.  
  5.     Hiliting with the hilight color??? Problem
  6.     'aete' TMPL wanted
  7.     Verifying valid handles, how to?
  8.     Memory allocation in your app
  9.  
  10.  
  11.  
  12. The Comp.Sys.Mac.Programmer Digest is moderated by Michael A. Kelly.
  13.  
  14. The digest is a collection of article threads from the usenet newsgroup
  15. comp.sys.mac.programmer.  It is designed for people who read c.s.m.p. semi-
  16. regularly and want an archive of the discussions.  If you don't know what a
  17. newsgroup is, you probably don't have access to it.  Ask your systems
  18. administrator(s) for details.  If you don't have access to news, you can
  19. post articles to any newsgroup by mailing your article to
  20.     newsgroup@cs.utexas.edu
  21. So, to post an article to comp.sys.mac.programmer, mail your article to
  22.     comp-sys-mac-programmer@cs.utexas.edu
  23. Note the '-' instead of '.' in the newsgroup name.  Be sure to ask that
  24. replies be emailed to you instead of posted to the group, and give your
  25. email address.
  26.  
  27. Each issue of the digest contains one or more sets of articles (called
  28. threads), with each set corresponding to a 'discussion' of a particular
  29. subject.  The articles are not edited; all articles included in this digest
  30. are in their original posted form (as received by our news server at
  31. cs.uoregon.edu).  Article threads are not added to the digest until the last
  32. article added to the thread is at least one month old (this is to ensure that
  33. the thread is dead before adding it to the digest).  Article threads that
  34. consist of only one message are generally not included in the digest.
  35.  
  36. The entire digest is available for anonymous ftp from ftp.cs.uoregon.edu
  37. [128.223.8.8] in the directory /pub/mac/csmp-digest.  Be sure to read the
  38. file /pub/mac/csmp-digest/README before downloading any files.  The most
  39. recent issues are available from sumex-aim.stanford.edu [36.44.0.6] in the
  40. directory /info-mac/digest/csmp.  If you don't have ftp capability, the sumex
  41. archive has a mail server; send a message with the text '$MACarch help' (no
  42. quotes) to LISTSERV@ricevm1.rice.edu for more information.
  43.  
  44. The digest is also available via email.  Just send a note saying that you
  45. want to be on the digest mailing list to mkelly@cs.uoregon.edu, and you will
  46. automatically receive each new issue as it is created.  Sorry, back issues
  47. are not available through the mailing list.
  48.  
  49. Send administrative mail to mkelly@cs.uoregon.edu.
  50.  
  51.  
  52. -------------------------------------------------------
  53.  
  54. From: pcw@access.digex.com (Peter Wayner)
  55. Subject: Hiliting with the hilight color??? Problem
  56. Date: 21 Jan 93 14:36:01 GMT
  57. Organization: Express Access Online Communications, Greenbelt MD USA
  58.  
  59. I've been having problems with hilighting some text using
  60. the hilighting color. If I use the InvertRect command without
  61. doing anything, then it is possible to toggle between regular
  62. black on white text and inverted white on black text with
  63. a single call to InvertRect. 
  64.  
  65. If I clear the top bit of the right part of the toolbox memory,
  66. then I get a perfect result the first time I call InvertRect.
  67. The text goes from black on white to black on hilight color. But
  68. on the second call when I try to revert the text to normal, it turns
  69. black. 
  70.  
  71. What's the trick? Why isn't it toggling?
  72.  
  73. Any help would be much apprciated. Thanks....
  74.  
  75. Peter Wayner
  76. (pcw@access.digex.com)
  77.  
  78. +++++++++++++++++++++++++++
  79.  
  80. From: absurd@apple.apple.com (Tim Dierks, software saboteur)
  81. Date: 21 Jan 93 16:12:49 GMT
  82. Organization: MacDTS Marauders
  83.  
  84. In article <pcw.727626961@digex>, pcw@access.digex.com (Peter Wayner)
  85. wrote:
  86. > 
  87. > I've been having problems with hilighting some text using
  88. > the hilighting color. If I use the InvertRect command without
  89. > doing anything, then it is possible to toggle between regular
  90. > black on white text and inverted white on black text with
  91. > a single call to InvertRect. 
  92. > 
  93. > If I clear the top bit of the right part of the toolbox memory,
  94. > then I get a perfect result the first time I call InvertRect.
  95. > The text goes from black on white to black on hilight color. But
  96. > on the second call when I try to revert the text to normal, it turns
  97. > black. 
  98. > 
  99. > What's the trick? Why isn't it toggling?
  100. > 
  101. > Any help would be much apprciated. Thanks....
  102. > 
  103. > Peter Wayner
  104. > (pcw@access.digex.com)
  105.  
  106. If you're using the HiliteMode low memory global, you need to turn it
  107. on before each and every invert call you make; it will turn itself off.
  108. In essence, it's just a flag to say "Make the next invert call hilite".
  109. If you want a more permanent solution (also good because it doesn't use
  110. low memory globals), just use the hilite transfer mode; it will do
  111. the hiliting for you and it won't turn off.
  112.  
  113. Tim Dierks
  114. MacDTS, but I speak for myself
  115.  
  116. +++++++++++++++++++++++++++
  117.  
  118. From: rick@akbar.cc.utexas.edu (Rick Watson)
  119. Date: 23 Jan 1993 03:17:16 GMT
  120. Organization: University of Texas at Austin
  121.  
  122. >If I clear the top bit of the right part of the toolbox memory,
  123. >then I get a perfect result the first time I call InvertRect.
  124. >The text goes from black on white to black on hilight color. But
  125. >on the second call when I try to revert the text to normal, it turns
  126. >black. 
  127.  
  128. Did you remember to do the BitClr((Ptr)HiliteMode,pHiliteBit);
  129. before each InvertRect? Quickdraw resets the bit after 
  130. various calls. This is documented somewhere in the vicinity
  131. of the description of pHiliteBit.
  132.  
  133. Rick Watson 
  134. The University of Texas Computation Center, Networking Services, 512/471-3241
  135.    internet: r.watson@utexas.edu             bitnet: watson@utadnx
  136.    uucp:     ...!cs.utexas.edu!ut-emx!rick   span:   utspan::utadnx::watson
  137.  
  138. ---------------------------
  139.  
  140. From: povlphp@uts.uni-c.dk (Povl H. Pedersen)
  141. Subject: 'aete' TMPL wanted
  142. Organization: UNI-C, Danish Computing Centre for Research and Education
  143. Date: Wed, 20 Jan 1993 18:40:06 GMT
  144.  
  145. Subject says it all. Please mail me an aete TNPL if you have one.
  146. I am going to start doing some AE stuff.
  147. - -- 
  148. Povl H. Pedersen   -   Macintosh specialist. Knows some DOS and UNIX too.
  149. pope@imv.aau.dk    -   povlphp@uts.uni-c.dk
  150.  
  151. +++++++++++++++++++++++++++
  152.  
  153. From: ross@bnr.ca (Ross Brown)
  154. Organization: Bell-Northern Research Ltd.
  155. Date: Wed, 20 Jan 1993 19:33:27 GMT
  156.  
  157. In article <1993Jan20.184006.15422@uts.uni-c.dk> povlphp@uts.uni-c.dk (Povl H.
  158. Pedersen) writes:
  159. >Subject says it all. Please mail me an aete TNPL if you have one.
  160. >I am going to start doing some AE stuff.
  161. >-- 
  162. >Povl H. Pedersen   -   Macintosh specialist. Knows some DOS and UNIX too.
  163. >pope@imv.aau.dk    -   povlphp@uts.uni-c.dk
  164. >
  165.  
  166. Here is the template.  It's not useful most of the time, because 'aete'
  167. resources are too big for ResEdit to display using a template.  I have also
  168. included a stuffed version of the Rez types file, which is more useful.
  169.  
  170. (This file must be converted with BinHex 4.0)
  171.  
  172. :"'&PG'8!FR0bBe*6483!N!J*Z%+E!*!%!3#3!`Q"!!!)J3#3!cF!!%0K$P*PB@3
  173. J6@8J,5!b9f&jC3)!N!0849K8G(4iG!4KCA4PJ3)!N!0bFh*M8P0&4!#3#PDr!*!
  174. %FR0bBe*6483!N"LRJa"-!*!'#EJ!N!`I!*!$3f%C9(*TB@`J9A0PFLGc)%GeD@4
  175. P)#dJ-PGKH3)!N!0849K8G(4iG!%!!$3!N!C*!`#3"$rN!!"#!*!&!D`!!!B!T[I
  176. M#DEr&@)!N"D0U3!,!*!+#(d@9'9YF'aKG'8J6@&UEh)J9Q9bFfP[ENK#@93@9'9
  177. YF'aKG'8J6@PZEh)J9Q9bFfP[ENK#@94!6'&ZCh9KCf8J583J,5"cD'peE'3JBQ8
  178. JFf&YC5"KFb"dD'Pc)(*PFfpeFQ0P)%P%)#dJ-#"QEh)J4@jRE'PcD%4A8N3,8f0
  179. bDA"d)%0[C'9%9e*%#e0eDA4PFb"XDA0d6d019!8UN!9-8e4$#P0eDA4P)%jKE@9
  180. 38e45"f0[E@ePER438e45"5U3"8&A8N3+8h9TG'8J3fpNC94138d,8h9TG'8J6'9
  181. fC@a%9e*%$90eDA4P)&CPFR0TEfj%9e*%#eP[GA)J4ACPER4c6d019!8UN!9-8e4
  182. $#89fC@jd6Q&YC9"69&)(BfpYE@9ZG&"69&)&+T!&39G54!p&GQ9ZG%0XBA0c)'0
  183. [C'986N&0$%9fC@jd583JBfpNC94138dF8Q9`E(NJ9(P`C5`JEh)JER9XE#"QEh)
  184. JEQpZC94138d08Q9`E(NJBfpYE@9ZG&"69&)&+T!&39G54"&5CA"XH5"TFb"2F(4
  185. TEfjKE%*#593C3f&Z)'*P)'%JD'pYEfGPEQ9[GA-JE'PcG%*#59355A-J4@jeE@9
  186. bBA4PC#"dHA"P3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9
  187. N3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0
  188. PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593
  189. )FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593H4'PbC@0d)&"
  190. KFQ&YCA4PFL"`FQ9QCA*PC#"dHA"P9%j"64K%DA*PBh3J8'&bB@ePG'9b)'0[E@e
  191. PER438e45"5U3"8&A8N394'PbC@0d)&"KFQ&Y)%p`G'P[EQ&X3N**9"P$B@iJBQ8
  192. JB5"SEfe[Cf9ZC@peFb"XDA0d3N**9"**Fb"&ER9YCA*KG'9N)(4jF'9#3NP8$%0
  193. SB@jRC5"6G'&dC8*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRC
  194. PC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593)FQ9
  195. cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP
  196. 8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#594I6h4SCA)J8'&bB@ePG'9bFbiJ)%j
  197. [G'8JG'KKG#"[FQ4PFL"TFb"cD@GZD@CTBf&ZG#`JGfKPEL"`BA*KE@9dCA*c)'&
  198. bC5"XDA0dC@3JGfPdD'peG#"VCAPhEh*NFbj23dj8"5U3"8a69%-18'&bB@ePG'9
  199. b)%jKE@938e45"5U3"8&A8N318'&bB@ePG'9b)%0[C'986N&0$P"KFQ&YCA4PFL"
  200. dHA"P9%j"64&3BA*KE@9dCA)JBfpYE@9ZG&"69&)&+T!&39G54!YTCL"[F(4TEfj
  201. KE%*#593C3f&Z)'*P)'%JD'pYEfGPEQ9[GA-JE'PcG%*#59355A-J4@jeE@9bBA4
  202. PC#"dHA"P3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N*
  203. *9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRC
  204. PC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593)FQ9
  205. cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593&+T!&6&08438UN!9
  206. - -8e4&"d0XBA0cCA023dj8"5U3"8a69%-+3faKFh-J6Q&YC9"69&)&+T!&39G54!T
  207. $E'&cFb"$Ef4P9%j"63GMEfeYC@jd8&088J8UN!9"9e*%#P"bEh"PFR4TCA023dj
  208. 8"5U3"8a69%-*8(*[F#"1B@eP8&088J8UN!9"9e*%#9"bEh!J3fpNC94138d+8(*
  209. [F#"$E'&cFe4138d(BfpYE@9ZG&"69&)&+T!&39G54!KbCA0PFRCPC%*#593C3f&
  210. Z)'*P)'%JD'pYEfGPEQ9[GA-JE'PcG%*#59355A-J4@jeE@9bBA4PC#"dHA"P3N*
  211. *9!T5C@&N,eGbDA4P3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9
  212. bGQ9N3N**9!KbCA0PFRCPC%*#593&+T!&4N*C9!8UN!9-8e4&#%9XC@ePER4c6d0
  213. 19!8UN!9-8e4$%N9XC@ePER3J3faKFh-J3fpNC94138d*5f9j)%C[FQec6d019!8
  214. UN!9-8e4$#8C[FQdJ3fpNC94138d&+T!&6&08438UN!9-8e4&"5U3"8a69%883fp
  215. YF'&bDA0[EL"2F'9bBA4[FR023dj8"5U3"8a69%-%EQ&YC9"69&)&+T!&39G54!4
  216. MEf4P9%j"63GMEfeYC@jd8&088J8UN!9"9e*%"5U3"8a69%8*3fpZFh4KER4c6d0
  217. 19!8UN!9-8e4$$89ZG@ePFQ&dEh)J58486N&0#d9ZG@ePFQ&dEh*c6d019!8UN!9
  218. - -8e4$$d9ZG@ePFQ&dEh)J6Q&YC9"69&)&+T!&39G54!e&ER9YCA*KG'pb)%P%9%j
  219. "64*&ER9YCA*KG'pb)%0[E@ePER438e45"5U3"8&A8N3&+T!&6&08438UN!9-8e4
  220. &"5U3"8a69%8!!!%!N!-*J3!!#)%!N!-h!#bI,!pZ!*!$(!!b!!"869"-!*!$#J#
  221. !!*!(,*lX"'&PG'83RJ:
  222.  
  223. (This file must be converted with BinHex 4.0)
  224.  
  225. :#'&PG'8ZFfPd!&0*9%46593K!*!%#1J!!!&'#h96593K!!%!!!MSFNaKG3+`!*!
  226. $&J!i$3d43899Ff9b9'9bE94jF'9c,R*%!*!0piN!N"VrN!4849K869"6)!!!TD'
  227. `'k@KX"X!!!`#!!!bK3!!!dd!!!89RdJN!*!(Jj`d"%%5"&(R9)+)`XT'BPAV0"Y
  228. 3RTqcGlrXq2`#JYMeMXh-m1U#TZdE*2BB@'SXb65@M-SF9f`XM5qK8(**Mb'CrG)
  229. bQL)8a5,iJG(lIHhXbcFML2D(%%3d9CT8RPHA*DQ4kFE5(L2bb`ML`)HUX951kFS
  230. Xb5l&A'jjR%Gm5*UD%M%UIj3a2VX03B`reiba'0Cp@95c2YQ&`pTYAaBrXT!!)2E
  231. G%K!f%Ek*B2dX5DR9Yl``"rhFZ`q,-+*@``dcMD1+#l,,M%d('8Y+miX+QlC-f#B
  232. qHA"kXU&[GQ&HHADHX@R[j+CYQTD1,#S['0&dZ,&TDIBSBp2XdUCP)r0,QjBB5i[
  233. +5h,-)[P0FiY+Q[BSc#[),ah*QNM0+-m[-jBf4AaprqkTQE9DXGrmM-cZ84c66%8
  234. c&4QCkC%j4D0''3[,@-bLcLiDBFa-6Hc(Hc$l'NFE#eK23hMFbSZl["Bc-(Z-4[e
  235. eRlT-i8Mp*Y-jjZb#l0,5TMPQTck13dP+3PDkXEKJA&0ffLFfa@6AP"F8F"'[+5V
  236. N"%BRjjFBFmUDTQ@AS-IeaT+Qa5A'A'1*F866-K5&41ER%Y%8KR3IL90'!l+i$'H
  237. `0+PhjSBIbjRpLmX`iq8&,$10$b0'-A$m9T@-0Sli$`"`EY,3c'(pbdCL2(C3kq+
  238. E0NdY`P&E2c+l$11[4M+0r,Vm[-,mh2bFl-+beNh(M$3@0LfZ865c5icFX0-!01D
  239. AiFjBhh4[ilJa+,iZrY246&Xp%()qSa3jr&'+(+M!ej2NcFrpVi,*q1R-f(R1@Be
  240. iZ+fbDZdUm[+l4QCY`6,RR[eA89*8E#`Tbrr-3JT,Y"d)9"VJSLCR+ZiR*GfB2D*
  241. Trm+#FIpj-"R1#"Jp#SbXrEi!-m`dNC1GAFSZaR&0HaD9M2SXEh"XPIj4Fj!!BGf
  242. ,4Z%H@Pf+*mc91$h,biT+eYV4#mf6SeI[phiMrhrAK+Z)T4#eqq%L@9P%e+jGZff
  243. VTQXZ)5*-D&ZhGQdLJQ#)ABNGU61SNZTH[(RP[m4AmHE'Y[K-*Ij5e[FbpkY[Mke
  244. c+b*Ca*i%L5pXLe!J!jrDjQ-rJAkEI@[cYQCeY58FYSNiir9LKL&Ue4J+XBeV)lE
  245. 6XihPCGLX0ri2!*!$$8jAmLY""M"K4QlP*k&NXqc)M"*1RN@6Nk1%Nq2d#1dLR%`
  246. "eK0i[3"B!(PaJ#qQK"&1d)pBi#CpGRR*r$`jV518F#-mCQ6!bA-bi'6!eMLH(2k
  247. !(AAiairJ#)dUp3$K'CU"jSAP5KSB+Ye*ck2(AF*j@K3#B@q-dX)2"M@m3*ecUB3
  248. D65S5TN,XET8b`b%B0NDD4Mh'V,[&Kfj'aqm93rF34BdjjRfLaSI`))%m!'k!8,R
  249. %$)MB9[Jf*aE)*XcZ&XU-$lY1YdC@8%1`ahJM*A(`8LEGAa`6rc6NY#Ld'[1-a1K
  250. 2)T0GP4HP4Ed0qh,`[k#rR43)2BDPlF(VEUGcM#F%D(&R*RR1ALS0Bp6'kF-PI,2
  251. lc10I)C*3&iKF@K`K'4IP5("c$&r$&p[`NK9-NM(Ska2`C)L&B(*8XK(#3'8Np4a
  252. IUja*Keja*mKJS`6B)K,8`iHlUT4@$6plAR+,j[-G'QGDX`Q%!Hq#6UF`9R-jUN9
  253. ec"`!5*EAa0C!@HhS#Sd*2T,`5ZQX"I4M1IQm)5D)JfB#K*)MdLrK9I6fb8ie@P6
  254. i6!D"Ba4r)%@c,U"DfrJi#VC*aJNMd6J,3a!p8S!LE'kF+k#9F9E1Z6$1KA-UHJ2
  255. "M#m!Iq,0M(D+eZP)GB5&Q*!!5hUb&++h%cU#'h(TqNlb!24*mVj5!TRXH$C(q(2
  256. *0@EE#C*kLZX6J5T9!kL"+86Ge)'RcN3J5T!!3'L""AeD%J9$-JVFYjJ(PJZDH@N
  257. Xp"%BiGGN+HlY`G$"QSDUQiSHUc[%M+p8GNq@16R2,SAe*BBl6pG-X8+Vr0b"HZM
  258. F2+'@e3&!j+L3!$cj#[UF!SjTE*acKHUm%fI!S(8Xm[Hi9Nd,j9UL$59MCp&kb$6
  259. ,c5aE-iUPJBA#MFD)[3lB&QfDXrr'E1$NYCQ'ECe),HPT,$A)dmcel[F&[JTGRlX
  260. IBMG`hFJ4ZjP#)qhZ-99pI'i*aI1XDFE@jZHTZl6#aLN2fbMV8dAh$"JhH"IeAfi
  261. HL[V9$Z'!E+*$XXG&3Y`N0)0TRA!Dk@3HRh4)95'Y&+Sm@%EjCC+IPrk@h%miF8`
  262. qBXE#Ab'Za9YeN6X&Dm2&"T*#XD01fc`PDDJ(9$(5m*,*SPfm,aH,G[&EZEKZ&cI
  263. PBY%ZVXV&4IDqkr4AU$G"[mCp'r5ALEQjC1kAm"jI9leJefhQiNif9B)iFleGp2Z
  264. maACa-m#q-$#ElrrH+["TKlGba+&@"@V,+e0%9p4ckji83#BE#QT5iKEFmAqmY(e
  265. G9k5%pFC4re5NH5bhTaeh25K*NkV3lcf)EC4S3L`lN!"L8QNk)1++"XJ0,!2Z4'S
  266. BZU%I0GQj-Sh$me"df2(+6AV-[aVAQpA+KU$'&5[9qEf'S'ZPqQ)MR@c%UDSpA1B
  267. f"U"PE+qiISH6Ej@ZPcU4E"U$eiQ9Ld4hj83V&RI#P41ckE+bP5+01CbRID-%R6!
  268. G+X2pT46YKER-6RV9lX1KI%peadfkfN-Eid!j86dY,-NlYqf8cUHBjNE*Jf,H8DH
  269. 6kkCDiG!@aL8e"DR[CKX'5ZXC5G*mA9pV42S8L2kYb,9c8V9a*hZcbk&Q-+E$0"k
  270. QilI+0h$"jHYQRF#82Sh'H["D%TVqYF2@1*X*fRI$VKAk4SL&Z6p)dFDMIk1Afl[
  271. &kFRLhSP&kFm"2ai[6QJ+'((L!qrY)&4cZfMa2R&aZcJlAEbA+0`ZmZCimAlAF,X
  272. Brr%iqceMr'GMULJ`C-*JqN[MI`!!*km!!!%!N!-"&!#3!a3!N!-b26!a-M-d06B
  273. h!$Jj!*!$%*!4#'&PG'8ZFfPd!!)!N!06594%8dP8)3#3$&0*9%46593K!*!BTi-
  274. 4SJ#3!aB!!!&'#L#X3B"2K9@'BBTPN@Q9EjTeRhRB!+`$,3!()(j"c%k%6meKLfk
  275. @EjX!IJF6!!!J)!F@!!!J(J!!!Vj19J!!51Irr%+R2c`!!$mm!#![2)3%!!bSY5!
  276. I0!!f2!!"3QF[2%Y$5&+TR$JI$%3!!'F!!1i-4!!"C`!!mN*'3UF[2%Y$5!#3!a!
  277. !+`!&!4J"qJ#3"J-!N!-"!*!$!43!N!-8!*!$-J!S)JJ2EJ#3!a`!-J!!8f9dC`#
  278. 3!`S!!2rr!*!&+'Md+AB:
  279.  
  280. ==============================================================================
  281. Ross Brown, Dept. 7C22  < Bell-Northern Research     >  Just the facts, ma'am.
  282. Advisor, Telemgmt Svcs  < P. O. Box 3511, Station C  >  We don't care whose
  283. ross@bnr.ca             < Ottawa, ON, Canada K1Y 4H7 >  opinions yours aren't.
  284. ==============================================================================
  285.  
  286.  
  287. +++++++++++++++++++++++++++
  288.  
  289. From: andrewb@nezsdc.icl.co.nz (Andrew Bevin)
  290. Date: Thu, 21 Jan 93 20:48:32 GMT
  291. Organization: Fujitsu New Zealand
  292.  
  293. In article <1993Jan20.184006.15422@uts.uni-c.dk> povlphp@uts.uni-c.dk (Povl H. Pedersen) writes:
  294. >Subject says it all. Please mail me an aete TNPL if you have one.
  295. >I am going to start doing some AE stuff.
  296. >-- 
  297. >Povl H. Pedersen   -   Macintosh specialist. Knows some DOS and UNIX too.
  298. >pope@imv.aau.dk    -   povlphp@uts.uni-c.dk
  299.  
  300. I would also, greatly appreciate an aete TNPL, if you have such a beast
  301. please mail a copy to me as well.
  302.  
  303.  
  304. - -- 
  305. Andrew Bevin                                       andrewb@icl.co.nz
  306. SDC, Fujitsu New Zealand                      ## I do not speak for Fujitsu! ##
  307. Auckland, New Zealand   
  308. - -------------------------------------------------------------------------------
  309.  
  310. +++++++++++++++++++++++++++
  311.  
  312. From: jpm@cs.hut.fi (Jussi-Pekka Mantere)
  313. Date: 22 Jan 93 00:29:27 GMT
  314. Organization: Helsinki University of Technology, Finland
  315.  
  316. Povl H. Pedersen <povlphp@uts.uni-c.dk> writes:
  317.  
  318.    Subject says it all. Please mail me an aete TNPL if you have one.
  319.    I am going to start doing some AE stuff.
  320.  
  321. You'd rather want to use an aete HyperCard stack, found on the
  322. Developer CD's.
  323.  
  324. (Sorry, I don't have the CD handy, but will look the path up if
  325. necessary.)
  326.  
  327. Cheers,
  328.  
  329. Jussi-Pekka Mantere
  330.  
  331. +++++++++++++++++++++++++++
  332.  
  333. From: lai@Apple.COM (Ed Lai)
  334. Date: 23 Jan 93 15:48:43 GMT
  335. Organization: Apple Computer Inc, Cupertino, CA
  336.  
  337. In article <JPM.93Jan22022927@cardhu.cs.hut.fi> jpm@cs.hut.fi (Jussi-Pekka Mantere) writes:
  338. >Povl H. Pedersen <povlphp@uts.uni-c.dk> writes:
  339. >
  340. >   Subject says it all. Please mail me an aete TNPL if you have one.
  341. >   I am going to start doing some AE stuff.
  342. >
  343. >You'd rather want to use an aete HyperCard stack, found on the
  344. >Developer CD's.
  345. >
  346.  
  347. You can also find the latest version (among other Apple Events related stuff)
  348. from ftp.apple.com in the directory /pub/appleevents
  349.  
  350. >(Sorry, I don't have the CD handy, but will look the path up if
  351. >necessary.)
  352. >
  353. >Cheers,
  354. >
  355. >Jussi-Pekka Mantere
  356.  
  357. /* Disclaimer: All statments and opinions expressed are my own */
  358. /* Edmund K. Lai                                               */
  359. /* Apple Computer, MS37-UP                                     */
  360. /* 20525 Mariani Ave,                                          */
  361. /* Cupertino, CA 95014                                         */
  362. /* (408)974-6272                                               */
  363. zW@h9cOi
  364.  
  365. ---------------------------
  366.  
  367. From: gwatts@fnalo.fnal.gov
  368. Subject: Verifying valid handles, how to?
  369. Organization: Fermi National Accelerator Lab
  370. Date: Fri, 22 Jan 1993 07:55:20 GMT
  371.  
  372. Hi all,
  373.   The first part is an amusing story.  The second request for help is aimed
  374. at anyone who is good at the memory manager. :)  Everyone, right? :)
  375.   I spent about 4 hours tracking down a but in my Think C 5.0.3 program
  376. yesterday.  It was crazy.  My color table kept getting corrupted.  I would
  377. never bomb in the same place.  Sometimes the "rb" command in MacsBug wouldn't
  378. even work!  I had icons explode into little dots.
  379.   Turns out (sheepish grin) I was deleteing an object twice. :)
  380.   At any rate, I was thinking.  I've got only indirect objects in my project.
  381. This means every object is a handle, right?  Well, why not, in the debug
  382. version of the message dispatcher (oopDebug library) put a little code that
  383. will check the object is infact allocated as a handle?
  384.   I checked out the routine in msg.c (in the oops Libraries folder), and
  385. the handle is stored in register a1.  I don't know, however, how to check
  386. if it is a valid handle without causing an error (bus or otherwise) of
  387. somesort.  Especially if it is a random number!  Anyone know?  Is there
  388. some memory manager routine, given a suspected handle, will tell me this?
  389.   By the way -- I do zero all objects after I delete them.  This case was
  390. a little more subtle than that (so don't yell at me :)).
  391.  
  392.     Cheers,
  393.         Gordon.
  394.  
  395.  
  396. +++++++++++++++++++++++++++
  397.  
  398. From: neeri@iis.ethz.ch (Matthias Neeracher)
  399. Date: 22 Jan 93 18:09:34 GMT
  400. Organization: Integrated Systems Laboratory, ETH, Zurich
  401.  
  402. In article <1993Jan22.015520.1@fnalo.fnal.gov>, gwatts@fnalo.fnal.gov writes:
  403. >   At any rate, I was thinking.  I've got only indirect objects in my project.
  404. > This means every object is a handle, right?  Well, why not, in the debug
  405. > version of the message dispatcher (oopDebug library) put a little code that
  406. > will check the object is infact allocated as a handle?
  407. >   I checked out the routine in msg.c (in the oops Libraries folder), and
  408. > the handle is stored in register a1.  I don't know, however, how to check
  409. > if it is a valid handle without causing an error (bus or otherwise) of
  410. > somesort.  Especially if it is a random number!  Anyone know?  Is there
  411. > some memory manager routine, given a suspected handle, will tell me this?
  412.  
  413. Here you go. This code is not guaranteed to work 100% of the time, but I doubt
  414. you will get it to produce an address error for any normal memory setup (One
  415. exception I can think of are macs with a memory upgrade that makes the ROM
  416. appear in the middle of the application heap).
  417.  
  418. /* Heuristic to determine whether a given address is a Handle            */
  419. /* Based on the articles of Lloyd Lim and Matthew T Russotto in the UMPG */
  420. /* This code may be redistributed without any restrictions               */
  421.  
  422. Boolean RealHandle(void * addr)
  423. {
  424.    THz   sysZone;
  425.    THz   applZone;
  426.    THz   heapZone;
  427.    
  428.    addr  =  StripAddress(addr);
  429.    if (addr && !((long) addr & 1))  {
  430.       sysZone  =  SystemZone();
  431.       applZone =  ApplicZone();
  432.       if (addr >= (Ptr) &sysZone->heapData   && 
  433.           addr <  (Ptr) sysZone->bkLim          ||
  434.           addr >= (Ptr) &applZone->heapData  && 
  435.           addr <  (Ptr) applZone->bkLim
  436.          )
  437.          if (*(long *)addr && !(*(long *)addr & 1)) {
  438.             heapZone =  HandleZone(addr);
  439.             if (!MemError())
  440.                if (heapZone == sysZone || heapZone == applZone)
  441.                   return true;
  442.          }
  443.    }
  444.    
  445.    return false;
  446. }
  447.  
  448. Matthias
  449.  
  450. - -----
  451. Matthias Neeracher                                      neeri@iis.ethz.ch
  452.  `We say "gestalt" when things combine to act in ways we can't explain'
  453.                              -- Marvin Minsky, _The Society Of Mind_
  454.  
  455. +++++++++++++++++++++++++++
  456.  
  457. From: keith@taligent.com (Keith Rollin)
  458. Date: 23 Jan 93 00:04:58 GMT
  459. Organization: Taligent
  460.  
  461. In article <NEERI.93Jan22190934@iis.ethz.ch>, neeri@iis.ethz.ch (Matthias
  462. Neeracher) wrote:
  463. > 
  464. > In article <1993Jan22.015520.1@fnalo.fnal.gov>, gwatts@fnalo.fnal.gov writes:
  465. > >   At any rate, I was thinking.  I've got only indirect objects in my project.
  466. > > This means every object is a handle, right?  Well, why not, in the debug
  467. > > version of the message dispatcher (oopDebug library) put a little code that
  468. > > will check the object is infact allocated as a handle?
  469. > >   I checked out the routine in msg.c (in the oops Libraries folder), and
  470. > > the handle is stored in register a1.  I don't know, however, how to check
  471. > > if it is a valid handle without causing an error (bus or otherwise) of
  472. > > somesort.  Especially if it is a random number!  Anyone know?  Is there
  473. > > some memory manager routine, given a suspected handle, will tell me this?
  474. > 
  475. > Here you go. This code is not guaranteed to work 100% of the time, but I doubt
  476. > you will get it to produce an address error for any normal memory setup (One
  477. > exception I can think of are macs with a memory upgrade that makes the ROM
  478. > appear in the middle of the application heap).
  479. > 
  480. > /* Heuristic to determine whether a given address is a Handle            */
  481. > /* Based on the articles of Lloyd Lim and Matthew T Russotto in the UMPG */
  482. > /* This code may be redistributed without any restrictions               */
  483. > 
  484. > Boolean RealHandle(void * addr)
  485. > {
  486. >    THz   sysZone;
  487. >    THz   applZone;
  488. >    THz   heapZone;
  489. >    
  490. >    addr  =  StripAddress(addr);
  491. >    if (addr && !((long) addr & 1))  {
  492. >       sysZone  =  SystemZone();
  493. >       applZone =  ApplicZone();
  494. >       if (addr >= (Ptr) &sysZone->heapData   && 
  495. >           addr <  (Ptr) sysZone->bkLim          ||
  496. >           addr >= (Ptr) &applZone->heapData  && 
  497. >           addr <  (Ptr) applZone->bkLim
  498. >          )
  499. >          if (*(long *)addr && !(*(long *)addr & 1)) {
  500. >             heapZone =  HandleZone(addr);
  501. >             if (!MemError())
  502. >                if (heapZone == sysZone || heapZone == applZone)
  503. >                   return true;
  504. >          }
  505. >    }
  506. >    
  507. >    return false;
  508. > }
  509.  
  510. I think that the above routine tries to validate any value that you might
  511. have lying around. However, if you have a value that you know at one time
  512. was a handle, you might want to check to see if it's on the free chain or
  513. not (this code is from MacApp):
  514.  
  515. Boolean IsFreeHandle(Handle aHandle)
  516. {
  517.     THz applZone = ApplicZone();
  518.     Handle currHandle = (Handle) applZone->hFstFree;
  519.  
  520.     while (currHandle != NULL)
  521.     {
  522.         if (currHandle == aHandle)
  523.             return TRUE;
  524.         currHandle = (Handle) * currHandle;
  525.     }
  526.     return FALSE;
  527. }
  528.  
  529. If course, nothing will help you if the master pointer has been
  530. re-allocated. Your old handle will now be pointing to a new, perfectly
  531. valid block of memory. I think the only thing you can do at that point is
  532. check the handle size against sizeof(TYourClass).
  533.  
  534. Greg Marriott (who was seen the other night at the Red Pepper with Cindy
  535. Jasper) wrote an INIT that tries to detect double-dispose bugs. It's on
  536. Apple's Developer CD and probably other places. Here are the release notes
  537. for your reading pleasure:
  538.  
  539. ;
  540. ;    DoubleTrouble - by Greg Marriott
  541. ;
  542. ;    ) 1992, Apple Computer, Inc.
  543. ;
  544. ;    DoubleTrouble is a debugging utility made to catch a common programming
  545. error:
  546. ;    freeing a handle that has already been freed.  (I call these errors
  547. Rdouble
  548. ;    dispose bugsSI)
  549. ;
  550. ;    When _DisposeHandle is called on a handle, the memory manager adds the
  551. handle
  552. ;    to its Rfree list,S a linked list of handles available for the allocator
  553. to use.
  554. ;    Calling _DisposeHandle on that handle again is usually benign.  The
  555. memory
  556. ;    manager dereferences the handle, pointing to the next handle in the free
  557. list.
  558. ;    If the the dereferenced handle points to the first handle in a master
  559. pointer block,
  560. ;    however, the handle appears valid because it points to a real block.  The
  561. memory
  562. ;    manager fails to realize the block is NOT a relocatable block (all master
  563. pointer
  564. ;    blocks are nonrelocatable), and marks it free (yikes!).  The freed master
  565. pointer
  566. ;    block is then used in a future allocation (usually very soon after being
  567. freed).
  568. ;    This mangles several master pointers and the free list.  Crashes soon
  569. follow.
  570. ;
  571. ;    This kind of bug is very hard to track down, and usually difficult to
  572. reproduce,
  573. ;    because master pointer blocks contain 64 handles (by default, some
  574. programs
  575. ;    change this behavior).  So, this situation only comes up about 1/64th of
  576. the
  577. ;    time.  When it happens, though, the results are inevitably catastrophic.
  578. ;
  579. ;    DoubleTrouble compares each handle being disposed to every handle in the
  580. free list of
  581. ;    the zone containing the handle.  If the handle is already in the free
  582. list, DoubleTrouble
  583. ;    breaks into the debugger with a message indicating whatUs going on. 
  584. Continuing execution
  585. ;    will stuff memWZErr (WhichZone failed, -111) into MemErr and d0 and
  586. return to the caller
  587. ;    (and NOT call through to _DisposeHandle).
  588. ;    
  589.  
  590. - -----
  591. Keith Rollin
  592. Phantom Programmer
  593. Taligent, Inc.
  594.  
  595. +++++++++++++++++++++++++++
  596.  
  597. From: peter@cujo.curtin.edu.au (Peter N Lewis)
  598. Organization: NCRPDA, Curtin University
  599. Date: Sat, 23 Jan 1993 10:01:36 GMT
  600.  
  601. In article <1993Jan22.015520.1@fnalo.fnal.gov>, gwatts@fnalo.fnal.gov
  602. wrote:
  603.  
  604. > the handle is stored in register a1.  I don't know, however, how to check
  605. > if it is a valid handle without causing an error (bus or otherwise) of
  606. > somesort.  Especially if it is a random number!  Anyone know?  Is there
  607.  
  608. here's a random attempt at it.  First check that the handle is even.  Then
  609. check that it points to an area inside your heap or inside the system heap,
  610. then check that h^ is inside the heap as well, and finally that recover
  611. handle gives the right value.
  612.  
  613.  function InsideHeap (p: univ ptr; hz: THz): boolean;
  614.  begin
  615.   InsideHeap := (longInt(p) >= longInt(hz)) & (longInt(p) <
  616. longInt(hz^.bkLim));
  617.  end;
  618.  
  619.  function ValidHandle (h: univ handle): boolean;
  620.   var
  621.    valid: boolean;
  622.  begin
  623.   valid := false;
  624.   if BAND(h, 1) = 0 then begin
  625.    if InsideHeap(h, ApplicZone) then begin
  626.     valid := (BAND(h^, 1) = 0) & InsideHeap(h^, ApplicZone);
  627.    end
  628.    else if InsideHeap(h, SystemZone) then begin
  629.     valid := (BAND(h^, 1) = 0) & InsideHeap(h^, SystemZone);
  630.    end;
  631.   end;
  632.   if valid then begin
  633.    valid := RecoverHandle(h^) = h;
  634.   end;
  635.   ValidHandle := valid;
  636.  end;
  637.  
  638. (Code tried and tested, but by no means guarenteed)
  639.  
  640. That would seem to be a good start...
  641.    Peter.
  642.  
  643. _______________________________________________________________________
  644. Peter N Lewis <peter@cujo.curtin.edu.au>             Ph: +61 9 368 2055
  645.  
  646. ---------------------------
  647.  
  648. From: bpb9204@tamsun.tamu.edu (Brent Burton)
  649. Subject: Memory allocation in your app
  650. Date: 22 Jan 1993 21:49:49 -0600
  651. Organization: Texas A&M Univ., Inc.
  652.  
  653. Just a quick question.
  654.  
  655. When your application  starts up, it gets a contiguous block of memory
  656. in which the program has its heap and stack.
  657.  
  658. I was looking through the Mem Mgr and found out that you can create more
  659. than one memory zone, where the NewPtr, NewHandle, and Dispose* calls
  660. are active.  Does this mean that, for example in a compiler, you may
  661. allocate hundreds of little chunks of memory, and then when you are
  662. done using them, you may deallocate them all by destroying that memory
  663. zone?  
  664.  
  665. Also, when your application exits, any chunks that were allocated from
  666. the New* calls are automatically returned, I assume? 
  667.  
  668. The reasons I ask these are for those one-shot programming tasks
  669. where I need to create some complex data structure, and then would
  670. like to free it all at once.
  671.  
  672. thanks,
  673. - -Brent
  674. - -- 
  675. +-------------------------+
  676. | Brent Burton    N5VMG   |    
  677. | bpb9204@tamsun.tamu.edu |  
  678. +-------------------------+ 
  679.  
  680. +++++++++++++++++++++++++++
  681.  
  682. From: orpheus@reed.edu (P. Hawthorne)
  683. Organization: Reed College, Portland, OR
  684. Date: Sat, 23 Jan 1993 05:41:28 GMT
  685.  
  686.   bpb9204@tamsun.tamu.edu (Brent Burton) asks:
  687. : I was looking through the Mem Mgr and found out that you can create more
  688. : than one memory zone, where the NewPtr, NewHandle, and Dispose* calls
  689. : are active.  Does this mean that, for example in a compiler, you may
  690. : allocate hundreds of little chunks of memory, and then when you are
  691. : done using them, you may deallocate them all by destroying that memory
  692. : zone?  
  693.  
  694.   You can do this, yes. It's remarkably simple. I think Rich Siegel posted
  695. a snippet of code that does this a couple of months ago. But, remember,
  696. the Macintosh memory manager is not designed to handle the oodles and
  697. oodles of blocks that your average compiler wants to deal with. If you have
  698. the time and the inclination, you can write a dynamic memory allocator
  699. with the same functionality as the memory manager, with remarkably
  700. different resource requirements.
  701.  
  702.   Here's an Object Pascal class I was working on last month.  It aint
  703. production quality, nor would it build right off the bat, but it's
  704. informative. It was going to become the memory zone class for the framework
  705. I've been working on, but the recent example apps I've been working on
  706. don't need variable length blocks, so it has been left to gather dust.
  707.  
  708.   It's your basic double two-way circular linked list of free and allocated
  709. blocks, but it doesn't use tags per se. It isn't very faithful to the sort
  710. of allocs you generally see around, but then, it's really cool for the
  711. stone age Macintosh memory model, so, I guess it's okay. Sometimes
  712. reinventing the wheel can be a lot of fun! I'd like to implement the binary
  713. free tree technique that's mentioned in an exercise in Knuth, but haven't
  714. had time. Maybe someone else could do it. I've radically changed the
  715. WackyHandle datatype so that it can migrate between temporary memory and
  716. application memory at will, for instance on suspend and resume events, but
  717. this class doesn't grok the new interface.
  718.  
  719.   Oh, by the way, it uses offsets from a handle instead of pointers so
  720. there is some dereferencing overhead, which reflects my idiosyncratic two
  721. cents worth on memory management. Also, it presently uses a method for
  722. dereferencing blocks, which reflects my feelings about typing while coding
  723. extremely dangerous and sleazy hacks like this.
  724.  
  725.   Commentary more than just welcome.
  726.  
  727.   Cut here.
  728.  
  729.  
  730. Unit QPool;
  731.  
  732. Interface
  733.  
  734. Uses
  735.  Core;
  736.  
  737. Type
  738.  BlockO = Longint;
  739.  BlockP = ^BlockR;
  740.  BlockR = Record
  741.    length: Longint;
  742.    backBlock, nextBlock: BlockO;
  743.    free: Boolean;
  744.    backFree, nextFree: BlockO;
  745.   End;
  746.  BlockA = Array[1..256] Of BlockR;
  747.  BlockAP = ^BlockA;
  748.  BlockAH = ^BlockAP;
  749.  
  750. Const
  751.  BlockRSize = Longint(SizeOf(BlockR));
  752.  SizeOfFreeLinks = Longint(SizeOf(BlockO) + SizeOf(BlockO));
  753.  poolHead = 0;
  754.  freeHead = BlockRSize;
  755.  HeaderSize = Longint(BlockRSize + BlockRSize);
  756.  
  757. Type
  758.  QPool = Object(QContent)
  759.    pool: BlockAH;
  760.  
  761.    presentCapacity: Longint;
  762.    usedCapacity: Longint;
  763.    usualCapacity: Longint;
  764.    growthCapacity: Longint;
  765.  
  766.    freeCount: Longint;
  767.    freeCursor: BlockO;
  768.  
  769.    usesTemporaryMemory: Boolean;
  770.  
  771.    Function QPool.Construct: Boolean;
  772.    override;
  773.    Procedure QPool.Destruct;
  774.    override;
  775.    Procedure QPool.Loosen;
  776.    override;
  777.    Procedure QPool.Fasten;
  778.    override;
  779.  
  780.    Procedure QPool.Check;
  781.  
  782.    Function QPool.Ref (aBlock: BlockO): BlockP;
  783.    Function QPool.AvailBlock (Var aBlock: BlockO; aSize: Longint): Boolean;
  784.    Procedure QPool.ReleaseBlock (Var aBlock: BlockO);
  785.    Procedure QPool.ChangeBlock (source, destination: BlockO);
  786.    Procedure QPool.Compact;
  787.   End;
  788.  
  789.  
  790. Procedure QuiverTest;
  791.  
  792. Implementation
  793.  
  794. Function AvailWackyHandle (Var aHandle: Univ Handle; aSize: Longint; temporary: Boolean): Boolean;
  795.  Var
  796.   aResult: OSErr;
  797.  Begin
  798.  If temporary Then
  799.   Begin
  800.   aHandle := MFTempNewHandle(aSize, aResult);
  801.   If aHandle <> Nil Then
  802.    If Not ourMemory.AddTemporaryHandle(aHandle) Then
  803.     Begin
  804.     MFTempDisposHandle(aHandle, aResult);
  805.     aHandle := Nil;
  806.     End;
  807.   End
  808.  Else
  809.   aHandle := NewHandleClear(aSize);
  810.  AvailWackyHandle := (aHandle <> Nil);
  811.  End;
  812.  
  813. Procedure ReleaseWackyHandle (Var aHandle: Univ Handle; temporary: Boolean);
  814.  Var
  815.   aResult: OSErr;
  816.  Begin
  817.  If temporary Then
  818.   Begin
  819.   MFTempDisposHandle(aHandle, aResult);
  820.   ourMemory.RemoveTemporaryHandle(aHandle);
  821.   End
  822.  Else
  823.   DisposHandle(aHandle);
  824.  aHandle := Nil;
  825.  End;
  826.  
  827. Procedure LockWackyHandle (aHandle: Univ Handle; temporary: Boolean);
  828.  Var
  829.   aResult: OSErr;
  830.  Begin
  831.  If temporary Then
  832.   MFTempHLock(aHandle, aResult)
  833.  Else
  834.   HLock(aHandle);
  835.  End;
  836.  
  837. Procedure UnlockWackyHandle (aHandle: Univ Handle; temporary: Boolean);
  838.  Var
  839.   aResult: OSErr;
  840.  Begin
  841.  If temporary Then
  842.   MFTempHUnlock(aHandle, aResult)
  843.  Else
  844.   HUnlock(aHandle);
  845.  End;
  846.  
  847. Function GrowWackyHandle (Var aHandle: Univ Handle; aSize: Longint; temporary: Boolean): OSErr;
  848.  Var
  849.   aNewHandle: Handle;
  850.   aResult: OSErr;
  851.   aBoolean: Boolean;
  852.  Begin
  853.  If temporary Then
  854.   Begin
  855.   aNewHandle := MFTempNewHandle(aSize, aResult);
  856.   If aNewHandle = Nil Then
  857.    Begin
  858.    GrowWackyHandle := aResult;
  859.    Exit(GrowWackyHandle);
  860.    End;
  861.   MFTempHLock(aNewHandle, aResult);
  862.   MFTempHLock(aHandle, aResult);
  863.   BlockMove(@aHandle^^, @aNewHandle^^, aSize);
  864.   MFTempDisposHandle(aHandle, aResult);
  865.   ourMemory.RemoveTemporaryHandle(aHandle);
  866.   aHandle := aNewHandle;
  867.   aBoolean := ourMemory.AddTemporaryHandle(aHandle);
  868.   GrowWackyHandle := noErr;
  869.   End
  870.  Else
  871.   GrowWackyHandle := GrowHandle(aHandle, aSize);
  872.  End;
  873.  
  874. Procedure SizeWackyHandle (Var aHandle: Univ Handle; aSize: Longint; temporary: Boolean);
  875.  Var
  876.   aNewHandle: Handle;
  877.   aResult: OSErr;
  878.   aBoolean: Boolean;
  879.  Begin
  880.  If temporary Then
  881.   Begin
  882.   aNewHandle := MFTempNewHandle(aSize, aResult);
  883.   If aNewHandle = Nil Then
  884.    Exit(SizeWackyHandle);
  885.   BlockMove(@aHandle^^, @aNewHandle^^, aSize);
  886.   MFTempDisposHandle(aHandle, aResult);
  887.   ourMemory.RemoveTemporaryHandle(aHandle);
  888.   aHandle := aNewHandle;
  889.   aBoolean := ourMemory.AddTemporaryHandle(aHandle);
  890.   MFTempHLock(aHandle, aResult);
  891.   End
  892.  Else
  893.   SizeHandle(aHandle, aSize);
  894.  End;
  895.  
  896. Function QPool.Construct: Boolean;
  897.  Var
  898.   freeP, poolP, newP: BlockP;
  899.  
  900.  Begin
  901.  Construct := false;
  902.  If Not Inherited Construct Then
  903.   Exit(Construct);
  904.  If (usualCapacity > BlockRSize) & AvailWackyHandle(pool, Longint(HeaderSize + usualCapacity), usesTemporaryMemory) Then
  905.   Begin
  906.   LockWackyHandle(pool, usesTemporaryMemory);
  907.   presentCapacity := HeaderSize + usualCapacity;
  908.  
  909.   poolP := Ref(poolHead);
  910.   poolP^.backBlock := HeaderSize;
  911.   poolP^.nextBlock := HeaderSize;
  912.  
  913.   freeP := Ref(freeHead);
  914.   freeP^.backFree := HeaderSize;
  915.   freeP^.nextFree := HeaderSize;
  916.   freeP^.free := true;
  917.  
  918.   newP := Ref(HeaderSize);
  919.   newP^.backBlock := poolHead;
  920.   newP^.nextBlock := poolHead;
  921.   newP^.backFree := freeHead;
  922.   newP^.nextFree := freeHead;
  923.   newP^.length := usualCapacity - BlockRSize;
  924.   newP^.free := true;
  925.  
  926.   poolP^.free := false;
  927.   poolP^.length := 0;
  928.   freeP^.free := true;
  929.   freeP^.length := 0;
  930.   freeP^.nextBlock := 0;
  931.   freeP^.backBlock := 0;
  932.  
  933.   freeCount := 1;
  934.   freeCursor := HeaderSize;
  935.   End
  936.  Else If AvailWackyHandle(pool, HeaderSize, usesTemporaryMemory) Then
  937.   Begin
  938.   LockWackyHandle(pool, usesTemporaryMemory);
  939.   presentCapacity := HeaderSize;
  940.  
  941.   poolP := Ref(poolHead);
  942.   poolP^.backBlock := poolHead;
  943.   poolP^.nextBlock := poolHead;
  944.  
  945.   freeP := Ref(freeHead);
  946.   freeP^.backFree := freeHead;
  947.   freeP^.nextFree := freeHead;
  948.   freeP^.free := true;
  949.   freeCursor := freeHead;
  950.   End
  951.  Else
  952.   Exit(Construct);
  953.  
  954.  usedCapacity := HeaderSize;
  955.  Construct := true;
  956.  End;
  957.  
  958. Procedure QPool.Destruct;
  959.  Begin
  960.  ReleaseWackyHandle(pool, usesTemporaryMemory);
  961.  Inherited Destruct;
  962.  End;
  963.  
  964. Procedure QPool.Loosen;
  965.  Begin
  966.  UnlockWackyHandle(pool, usesTemporaryMemory);
  967.  Inherited Loosen;
  968.  End;
  969.  
  970. Procedure QPool.Fasten;
  971.  Begin
  972.  Inherited Fasten;
  973.  LockWackyHandle(pool, usesTemporaryMemory);
  974.  End;
  975.  
  976. Function QPool.Ref (aBlock: BlockO): BlockP;
  977.  Begin
  978.  If aBlock < 0 Then
  979.   Debugger
  980.  Else If aBlock > presentCapacity Then
  981.   Debugger;
  982.  Ref := BlockP(Clean(LongintPtr(pool)^) + aBlock);
  983.  End;
  984.  
  985. Function QPool.AvailBlock (Var aBlock: BlockO; aSize: Longint): Boolean;
  986.  Var
  987.   startCursor: BlockO;
  988.   freeCursorP: BlockP;
  989.   leastSize, requiredSize, thisSize, newCapacity: Longint;
  990.   aBlockP, poolP, lastP, freeP: BlockP;
  991.   spareO: BlockO;
  992.   spareP: BlockP;
  993.   spareLength: Longint;
  994.   gotExtra: Boolean;
  995.  Begin
  996.  aSize := aSize - SizeOfFreeLinks;
  997.  If aSize < 0 Then
  998.   aSize := 0;
  999.  AvailBlock := false;
  1000.  
  1001.  If freeCount > 0 Then
  1002.   Begin
  1003.   leastSize := aSize + BlockRSize;
  1004.   requiredSize := leastSize + BlockRSize;
  1005.  
  1006.   startCursor := freeCursor;
  1007.   Repeat
  1008.    freeCursorP := Ref(freeCursor);
  1009.    If (freeCursor <> freeHead) And (Not freeCursorP^.free) Then
  1010.     Debugger;
  1011.    thisSize := freeCursorP^.length;
  1012.    If (freeCursor <> freeHead) & ((thisSize = leastSize) | (thisSize >= requiredSize)) Then
  1013.     Begin
  1014.     aBlock := freeCursor;
  1015.     usedCapacity := usedCapacity + BlockRSize + aSize;
  1016.  
  1017.     freeCursorP^.length := aSize;
  1018.     freeCursorP^.free := false;
  1019.     freeCount := freeCount - 1;
  1020.  
  1021.     spareLength := thisSize - aSize;
  1022. {If spareLength = 0 Then}
  1023. {DebugStr('Exact fit!');}
  1024. {Writeln('Exact fit at ', LongintToString(freeCursor), '.');}
  1025. {else}
  1026. {Writeln('Fit at ', LongintToString(freeCursor), '.');}
  1027.  
  1028.     If spareLength = 0 Then
  1029.      Begin {Cut this block out of the free list}
  1030.      Ref(freeCursorP^.backFree)^.nextFree := freeCursorP^.nextFree;
  1031.      Ref(freeCursorP^.nextFree)^.backFree := freeCursorP^.backFree;
  1032.      freeCursor := freeCursorP^.nextFree;
  1033.      End
  1034.     Else
  1035.      Begin
  1036.      spareO := freeCursor + BlockRSize + aSize;
  1037.      spareP := Ref(spareO);
  1038.  
  1039. {Replace this block in the free list with a new block toward the end}
  1040.      spareP^.backFree := freeCursorP^.backFree;
  1041.      spareP^.nextFree := freeCursorP^.nextFree;
  1042.      Ref(spareP^.backFree)^.nextFree := spareO;
  1043.      Ref(spareP^.nextFree)^.backFree := spareO;
  1044.  
  1045. {Insert this new block into the pool list}
  1046.      spareP^.nextBlock := freeCursorP^.nextBlock;
  1047.      Ref(spareP^.nextBlock)^.backBlock := spareO;
  1048.      freeCursorP^.nextBlock := spareO;
  1049.      spareP^.backBlock := freeCursor;
  1050.  
  1051.      spareP^.length := spareLength - BlockRsize;
  1052.      spareP^.free := true;
  1053.  
  1054.      freeCursor := spareO;
  1055.      freeCount := freeCount + 1;
  1056.      End;
  1057.  
  1058.     AvailBlock := true;
  1059.     Exit(AvailBlock);
  1060.     End
  1061.    Else
  1062.     freeCursor := freeCursorP^.nextFree;
  1063.   Until freeCursor = startCursor;
  1064.   End;
  1065.  
  1066.  gotExtra := (growthCapacity > BlockRSize);
  1067.  newCapacity := presentCapacity + BlockRSize + aSize + growthCapacity;
  1068.  If GrowWackyHandle(pool, newCapacity, usesTemporaryMemory) <> noErr Then
  1069.   Begin
  1070.   gotExtra := false;
  1071.   newCapacity := newCapacity - growthCapacity;
  1072.   If GrowWackyHandle(pool, newCapacity, usesTemporaryMemory) <> noErr Then
  1073.    Exit(AvailBlock);
  1074.   End;
  1075.  
  1076. {Writeln('Growing for ', LongintToString(presentCapacity), '.');}
  1077.  
  1078.  aBlock := presentCapacity;
  1079.  presentCapacity := newCapacity;
  1080.  usedCapacity := usedCapacity + BlockRSize + aSize;
  1081.  
  1082.  aBlockP := Ref(aBlock);
  1083.  poolP := Ref(poolHead);
  1084.  lastP := Ref(poolP^.backBlock);
  1085.  
  1086.  lastP^.nextBlock := aBlock;
  1087.  aBlockP^.backBlock := poolP^.backBlock;
  1088.  aBlockP^.nextBlock := poolHead;
  1089.  poolP^.backBlock := aBlock;
  1090.  
  1091.  aBlockP^.length := aSize;
  1092.  aBlockP^.free := false;
  1093.  
  1094.  If gotExtra Then
  1095.   Begin
  1096.   spareO := aBlock + BlockRSize + aBlockP^.length;
  1097.   spareP := Ref(spareO);
  1098.   spareP^.free := true;
  1099.   spareP^.length := presentCapacity - spareO - BlockRSize;
  1100.  
  1101.   aBlockP^.nextBlock := spareO;
  1102.   spareP^.backBlock := poolP^.backBlock;
  1103.   spareP^.nextBlock := poolHead;
  1104.   poolP^.backBlock := spareO;
  1105.  
  1106.   freeP := Ref(freeHead);
  1107.   spareP^.backFree := freeP^.backFree;
  1108.   spareP^.nextFree := freeHead;
  1109.   Ref(spareP^.backFree)^.nextFree := spareO;
  1110.   freeP^.backFree := spareO;
  1111.  
  1112.   freeCount := freeCount + 1;
  1113.   End;
  1114.  AvailBlock := true;
  1115.  End;
  1116.  
  1117. Procedure QPool.ReleaseBlock (Var aBlock: BlockO);
  1118.  Var
  1119.   aBlockP: BlockP;
  1120.   cursorO: BlockO;
  1121.   cursorP: BlockP;
  1122.  Begin
  1123.  aBlockP := Ref(aBlock);
  1124.  If aBlockP^.free Then
  1125.   Debugger;
  1126.  aBlockP^.free := true;
  1127.  
  1128.  usedCapacity := usedCapacity - BlockRSize - aBlockP^.length;
  1129.  
  1130.  If freeCount = 0 Then
  1131.   Begin
  1132.   cursorP := Ref(freeHead);
  1133.   cursorP^.backFree := aBlock;
  1134.   cursorP^.nextFree := aBlock;
  1135.   aBlockP^.nextFree := freeHead;
  1136.   aBlockP^.backFree := freeHead;
  1137.   End
  1138.  Else
  1139.   Begin
  1140.   cursorO := freeHead;
  1141.   cursorP := Ref(freeHead);
  1142.  
  1143.   If Abs(cursorP^.backFree - aBlock) <= Abs(cursorP^.nextFree - aBlock) Then
  1144.    Begin {Scan backward from head of free list}
  1145.    If (freeCursor > aBlock) Then
  1146.     cursorP := Ref(freeCursor);
  1147.    Repeat
  1148.     cursorO := cursorP^.backFree;
  1149.     cursorP := Ref(cursorO);
  1150.    Until (cursorO < aBlock) | (cursorO = freeHead);
  1151.    End
  1152.   Else
  1153.    Begin {Scan foreward from head of free list}
  1154.    If (freeCursor < aBlock) Then
  1155.     cursorP := Ref(freeCursor);
  1156.    Repeat
  1157.     cursorO := cursorP^.nextFree;
  1158.     cursorP := Ref(cursorO);
  1159.    Until (cursorO > aBlock) | (cursorO = freeHead);
  1160.    cursorO := cursorP^.backFree;
  1161.    cursorP := Ref(cursorO);
  1162.    End;
  1163.  
  1164.   aBlockP^.nextFree := cursorP^.nextFree;
  1165.   Ref(aBlockP^.nextFree)^.backFree := aBlock;
  1166.   aBlockP^.backFree := cursorO;
  1167.   cursorP^.nextFree := aBlock;
  1168.  
  1169.   If cursorP^.nextBlock = aBlock Then
  1170.    Begin
  1171. {Writeln('Joining ', LongintToString(cursorO), ' to ', LongintToString(aBlock), '.');}
  1172.    cursorP^.length := cursorP^.length + BlockRSize + aBlockP^.length;
  1173.    cursorP^.nextFree := aBlockP^.nextFree;
  1174.    Ref(cursorP^.nextFree)^.backFree := cursorO;
  1175.    cursorP^.nextBlock := aBlockP^.nextBlock;
  1176.    Ref(cursorP^.nextBlock)^.backBlock := cursorO;
  1177.  
  1178.    aBlock := cursorO;
  1179.    aBlockP := cursorP;
  1180.    freeCount := freeCount - 1;
  1181.    End;
  1182.  
  1183.   If aBlockP^.nextBlock = aBlockP^.nextFree Then
  1184.    Begin
  1185. {Writeln('Merging ', LongintToString(aBlock), ' with ', LongintToString(aBlockP^.nextFree), '.');}
  1186.    cursorP := Ref(aBlockP^.nextFree);
  1187.    aBlockP^.length := aBlockP^.length + BlockRSize + cursorP^.length;
  1188.    aBlockP^.nextFree := cursorP^.nextFree;
  1189.    Ref(aBlockP^.nextFree)^.backFree := aBlock;
  1190.    aBlockP^.nextBlock := cursorP^.nextBlock;
  1191.    Ref(aBlockP^.nextBlock)^.backBlock := aBlock;
  1192.    freeCount := freeCount - 1;
  1193.    End;
  1194.   End;
  1195.  
  1196.  freeCount := freeCount + 1;
  1197.  
  1198.  If (aBlock > usualCapacity) & (aBlockP^.nextBlock = poolHead) Then
  1199.   Begin
  1200. {Writeln('Truncating at ', LongintToString(aBlock), '.');}
  1201.  
  1202.   freeCount := freeCount - 1;
  1203.  
  1204.   Ref(freeHead)^.backFree := aBlockP^.backFree;
  1205.   Ref(aBlockP^.backFree)^.nextFree := freeHead;
  1206.  
  1207.   Ref(poolHead)^.backBlock := aBlockP^.backBlock;
  1208.   Ref(aBlockP^.backBlock)^.nextBlock := poolHead;
  1209.  
  1210.   freeCursor := Ref(freeHead)^.nextFree;
  1211.  
  1212.   presentCapacity := aBlock;
  1213.   SizeWackyHandle(pool, presentCapacity, usesTemporaryMemory);
  1214.  
  1215.   End
  1216.  Else
  1217.   freeCursor := aBlock;
  1218.  
  1219.  aBlock := 0;
  1220.  End;
  1221.  
  1222. Procedure QPool.Check;
  1223.  Var
  1224.   previousO, cursorO: BlockO;
  1225.   previousP, cursorP: BlockP;
  1226.   totalFree: Longint;
  1227.  Begin
  1228.  
  1229.  If usedCapacity < 0 Then
  1230.   Debugger;
  1231.  
  1232.  If freeCount < 0 Then
  1233.   Debugger;
  1234.  
  1235. {Check pool list}
  1236.  cursorO := poolHead;
  1237.  cursorP := Ref(poolHead);
  1238.  
  1239.  Repeat
  1240.   previousO := cursorO;
  1241.   previousP := cursorP;
  1242.   cursorO := cursorP^.nextBlock;
  1243.   cursorP := Ref(cursorO);
  1244.   If cursorP^.backBlock <> previousO Then
  1245.    Debugger;
  1246.  Until cursorO = poolHead;
  1247.  
  1248. {Check free list}
  1249.  If freeCount = 0 Then
  1250.   Begin
  1251.   If usedCapacity <> presentCapacity Then
  1252.    Nothing;
  1253.   End
  1254.  Else
  1255.   Begin
  1256.   cursorO := freeHead;
  1257.   cursorP := Ref(freeHead);
  1258.  
  1259.   totalFree := 0;
  1260.   Repeat
  1261.    previousO := cursorO;
  1262.    previousP := cursorP;
  1263.    cursorO := cursorP^.nextFree;
  1264.    cursorP := Ref(cursorO);
  1265.    If cursorO <> freeHead Then
  1266.     totalFree := totalFree + cursorP^.length + BlockRSize;
  1267.    If cursorP^.backFree <> previousO Then
  1268.     Debugger;
  1269.    If cursorP^.nextFree = cursorP^.nextBlock Then
  1270.     Debugger;
  1271.   Until cursorO = freeHead;
  1272.  
  1273.   If Abs(totalFree - (presentCapacity - usedCapacity)) > 0 Then
  1274.    Debugger;
  1275.   End;
  1276.  End;
  1277.  
  1278. Procedure QPool.ChangeBlock (source, destination: BlockO);
  1279.  Var
  1280.   a: Longint;
  1281.  Begin
  1282. {if source <> destination then}
  1283. {for a := 1 to N do}
  1284. {if offsets[a] = source then}
  1285. {begin}
  1286. {offsets[a] := destination;}
  1287. {Leave;}
  1288. {end;}
  1289.  End;
  1290.  
  1291. Procedure QPool.Compact;
  1292.  Var
  1293.   FreeP, PoolP: BlockP;
  1294.   TargetO, StartO, FinishO, NextTargetO, CursorO, NextCursorO: BlockO;
  1295.   TargetP, StartP, FinishP, NextTargetP, CursorP: BlockP;
  1296.   Delta, Length: Longint;
  1297.  
  1298.  Begin
  1299.  FreeP := Ref(freeHead);
  1300.  PoolP := Ref(poolHead);
  1301.  
  1302.  FreeCursor := freeHead;
  1303.  
  1304.  While (FreeP^.nextFree <> freeHead) & (PoolP^.backBlock <> FreeP^.nextFree) Do
  1305.   Begin
  1306.   TargetO := FreeP^.nextFree;
  1307.   TargetP := Ref(TargetO);
  1308.  
  1309.   StartO := TargetP^.nextBlock;
  1310.   StartP := Ref(StartO);
  1311.  
  1312.   NextTargetO := TargetP^.nextFree;
  1313.   If NextTargetO = freeHead Then
  1314.    NextTargetO := poolHead;
  1315.   NextTargetP := Ref(NextTargetO);
  1316.  
  1317.   FinishO := Ref(NextTargetO)^.backBlock;
  1318.   FinishP := Ref(FinishO);
  1319.  
  1320.   CursorO := StartO;
  1321.   CursorP := StartP;
  1322.   Delta := TargetO - StartO;
  1323.   Length := 0;
  1324.   Repeat
  1325.    Length := Length + BlockRSize + CursorP^.length;
  1326.    ChangeBlock(CursorO, CursorO + Delta);
  1327.  
  1328.    CursorP^.backBlock := CursorP^.backBlock + Delta;
  1329.    CursorO := CursorP^.nextBlock;
  1330.    CursorP^.nextBlock := CursorP^.nextBlock + Delta;
  1331.    CursorP := Ref(CursorO);
  1332.   Until CursorO = NextTargetO;
  1333.  
  1334.   CursorO := TargetO + Length;
  1335.   CursorP := Ref(CursorO);
  1336.   StartP^.backBlock := TargetP^.backBlock;
  1337.   FinishP^.nextBlock := CursorO;
  1338.  
  1339.   BlockMove(Ptr(StartP), Ptr(TargetP), Length);
  1340.  
  1341.   CursorP^.length := Abs(Delta);
  1342.   If NextTargetO <> poolHead Then
  1343.    CursorP^.length := CursorP^.length + NextTargetP^.length;
  1344. {BlockRSize added and subtracted to CursorP^.length}
  1345.   CursorP^.free := true;
  1346.  
  1347.   CursorP^.backBlock := FinishO + Delta;
  1348.   CursorP^.backFree := freeHead;
  1349.   FreeP^.nextFree := CursorO;
  1350.  
  1351.   If NextTargetO = poolHead Then
  1352.    Begin
  1353.    CursorP^.nextFree := freeHead;
  1354.    FreeP^.backFree := CursorO;
  1355.  
  1356.    CursorP^.nextBlock := poolHead;
  1357.    PoolP^.backBlock := CursorO;
  1358.    End
  1359.   Else
  1360.    Begin
  1361.    CursorP^.nextFree := NextTargetP^.nextFree;
  1362.    Ref(CursorP^.nextFree)^.backFree := CursorO;
  1363.  
  1364.    CursorP^.nextBlock := NextTargetP^.nextBlock;
  1365.    Ref(CursorP^.nextBlock)^.backBlock := CursorO;
  1366.  
  1367.    FreeCount := FreeCount - 1;
  1368.    End;
  1369.   End;
  1370.  
  1371.  If (PresentCapacity > UsualCapacity) & (FreeP^.backFree = PoolP^.backBlock) Then
  1372.   Begin
  1373.   CursorO := FreeP^.backFree;
  1374.   CursorP := Ref(CursorO);
  1375.  
  1376. {Writeln('Shortening at ', LongintToString(CursorO), '.');}
  1377.  
  1378.   FreeP^.backFree := CursorP^.backFree;
  1379.   Ref(CursorP^.backFree)^.nextFree := freeHead;
  1380.  
  1381.   PoolP^.backBlock := CursorP^.backBlock;
  1382.   Ref(CursorP^.backBlock)^.nextBlock := poolHead;
  1383.  
  1384.   presentCapacity := CursorO;
  1385.   SizeWackyHandle(Pool, PresentCapacity, usesTemporaryMemory);
  1386.  
  1387.   FreeCount := FreeCount - 1;
  1388.   End;
  1389.  
  1390.  End;
  1391.  
  1392. Procedure QuiverTest;
  1393.  Const
  1394.   N = 2500;
  1395.   MinimumLength = 12;
  1396.   MaximumLength = 24;
  1397.  
  1398.   iterationsBeforeReport = 4096;
  1399.  
  1400.  Var
  1401.   offsets: Array[1..N] Of BlockO;
  1402.   sizes: Array[1..N] Of Longint;
  1403.  
  1404.   epoch: Longint;
  1405.  
  1406.   aPool: QPool;
  1407.   a, e, i: Longint;
  1408.   aBlock: BlockO;
  1409.   aBlockP: BlockP;
  1410.   aStringP: StringPtr;
  1411.   anEvent: EventRecord;
  1412.  
  1413.  Begin
  1414.  ShowText;
  1415.  DebugStr('You must uncomment the ChangeBlock method.');
  1416.  
  1417.  For a := 1 To 4 Do
  1418.   randseed := randseed * TickCount * Random;
  1419. {randseed := Longint(-230814419);}
  1420.  Writeln('randseed = ', LongintToString(randseed));
  1421.  Writeln;
  1422.  
  1423.  New(aPool);
  1424.  aPool.Dub('The Pool We Are Testing.');
  1425.  aPool.usesTemporaryMemory := true;
  1426.  aPool.usualCapacity := Trunc(n * (BlockRSize + (minimumLength + maximumLength) / 2));
  1427.  aPool.growthCapacity := 1000;
  1428.  If Not aPool.Construct Then
  1429.   Exit(QuiverTest);
  1430.  
  1431.  i := aPool.usedCapacity;
  1432.  For a := 1 To N Do
  1433.   Begin
  1434.   e := MonteCarlo(MinimumLength, MaximumLength);
  1435.   i := i + e + BlockRSize;
  1436.   If Not aPool.AvailBlock(aBlock, e) Then
  1437.    Debugger;
  1438.   aBlockP := aPool.Ref(aBlock);
  1439.   If aBlockP^.free Then
  1440.    Debugger;
  1441.   aStringP := StringPtr(Clean(aBlockP) + BlockRSize - SizeOfFreeLinks);
  1442.   aStringP^ := LongintToString(Longint(e - SizeOfFreeLinks));
  1443.   offsets[a] := aBlock;
  1444.   sizes[a] := e;
  1445.   If i <> aPool.usedCapacity Then
  1446.    Nothing;
  1447. {aPool.Check;}
  1448.   End;
  1449.  
  1450.  Repeat
  1451.   e := MonteCarlo(1, N);
  1452.  
  1453.   aBlock := offsets[e];
  1454.   aBlockP := aPool.Ref(aBlock);
  1455.  
  1456.   If aBlock <> 0 Then
  1457.    Begin
  1458. {Writeln('Releasing ', LongintToString(aBlock), '.');}
  1459.    aStringP := StringPtr(Clean(aBlockP) + BlockRSize - SizeOfFreeLinks);
  1460.    If aStringP^ <> LongintToString(aBlockP^.length) Then
  1461.     Debugger;
  1462.  
  1463.    aPool.ReleaseBlock(offsets[e]);
  1464.    If offsets[e] <> 0 Then
  1465.     Debugger;
  1466.    sizes[e] := 0;
  1467.    End
  1468.   Else
  1469.    Begin
  1470.    i := MonteCarlo(MinimumLength, MaximumLength);
  1471.    If Not aPool.AvailBlock(offsets[e], i) Then
  1472.     If Not aPool.AvailBlock(offsets[e], i) Then
  1473.      Debugger;
  1474. {Writeln('Created ', LongintToString(offsets[e]), '.');}
  1475.    If offsets[e] = 0 Then
  1476.     Debugger;
  1477.    aBlockP := aPool.Ref(offsets[e]);
  1478.    aStringP := StringPtr(Clean(aBlockP) + BlockRSize - SizeOfFreeLinks);
  1479.    aStringP^ := LongintToString(Longint(i - SizeOfFreeLinks));
  1480.    sizes[e] := i;
  1481.    End;
  1482.  
  1483. {aPool.Check;}
  1484. {Writeln;}
  1485.  
  1486.   GetKeys;
  1487.  
  1488.   epoch := epoch + 1;
  1489.   If epoch > iterationsBeforeReport Then
  1490.    Begin
  1491. {If Button Then}
  1492.    Begin
  1493.    Write('CompactingI ');
  1494.    aPool.usualCapacity := aPool.usedCapacity;
  1495.    aPool.Compact;
  1496.    Write('Done. ');
  1497.    End;
  1498.  
  1499.    Writeln(PercentageToString(Percentage(aPool.usedCapacity, aPool.presentCapacity)), ' used.');
  1500. {aPool.Check;}
  1501.    epoch := 0;
  1502.  
  1503.    SystemTask;
  1504.    aPool.Loosen;
  1505.    If WaitNextEvent(everyEvent, anEvent, 3000, Nil) Then
  1506.     Nothing;
  1507.    aPool.Fasten;
  1508.    End;
  1509.  
  1510.   If epoch Mod (iterationsBeforeReport Div 4) = 0 Then
  1511.    Begin
  1512.    aPool.Loosen;
  1513.    If WaitNextEvent(everyEvent, anEvent, 0, Nil) Then
  1514.     Nothing;
  1515.    aPool.Fasten;
  1516.    End;
  1517.  
  1518.  Until SpaceKey;
  1519.  
  1520.  aPool.Destruct;
  1521.  End;
  1522.  
  1523. End.
  1524.  
  1525. ---------------------------
  1526.  
  1527. End of C.S.M.P. Digest
  1528. **********************
  1529.